home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d10
/
ps1410.arc
/
CAL4.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-10-31
|
78KB
|
2,105 lines
'=========================================================================
' Personal Calendar (PC) Program
' Copyright (c) 1985-1990, Paul Munoz-Colman. All Rights Reserved.
' Version 14.10
' 31 Oct 1990
' Shareware $25
'=========================================================================
' DOS File CAL4.BAS
' Independently Compiled Subprograms Which Are Linked With CAL1.BAS
'=========================================================================
' Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
' Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
'=========================================================================
' Note -- Tabs in the source file are in positions 6,11,16,21,26,...
'=========================================================================
' $INCLUDE: 'cal1.bi'
'=========================================================================
' Subprogram List in the Order of Appearance in this File
' (compiled WITHOUT error handling--no /E or /X)
'-------------------------------------------------------------------------
' Name Purpose
' --------------------------- ---------------------------------------
' Fn InString Interface with MhInstr
' Instructions Bottom of Clock Screen Instructions
' KeyStuff (KeyFunction) Get a Keystroke, Display Key States
' KillAFile (Filename$) Interface with MhKill
' Kolors (WhichSetting) Change Color Setting
' Fn Leap (LeapInput) Check if Given Year is a Leap Year
' LprintString (PrintString$,HoldPrint)
' Send to Printer With Error Recovery
' MajorBeeper Severe Attention Music (Errors)
' MenuDriver (MenuSize, MenuChoice, MenuRow, MenuColumn,
' MenuSingleLine, MenuSpecialExit, ScreenBottomsShow, FilenameShow)
' Menu Processor
' MinorBeeper Mild Attention Music (Messages)
' MoveApptRecords
' (FileStart, MoveStart, MoveEnd, MoveIncr, MoveOrigin,
' MoveTarget, MoveFlag, BlankFlag, BlankAt)
' Shift Records In Appointment File
' Myd2 (Destin$, DestinStart%, Chars%, Source$)
' Interface with MhMidString (Statement)
' NotesHistory (NotesorHistory$)
' Change Notes and History Menu
' Fn NumberError (NumberTest$) Check for Non-Numeric Characters
' OpenAppts Open Appointment File and Set FIELD
' Options Options Menus
' PageEject Eject Printer Page
' PlayAlarmWarning (WarningSet)
' Play Alarm or Warning Music String
' PopLine F10 to Pop Down Prompt
' PopLineDelete Erase Pop Down Prompt
'=========================================================================
FUNCTION InString (SearchIn$, SearchFor$) STATIC
'=========================================================================
' Interface to MhInstr, Ditches Two Arguments
DEFINT A-Z
SubnumSave = Subnum
Subnum = 117
CALL MhInstr(Pointer%, N1%, SearchIn$, SearchFor$)
InString = Pointer
Subnum = SubnumSave
END FUNCTION
'=========================================================================
SUB Instructions STATIC
'=========================================================================
' Refresh Bottom Of Clock Display User Instructions
DEFINT A-Z
SubnumSave = Subnum
Subnum = 34
IF ApptFile AND FooterSize >= N6 THEN ' Show F5 Help
ScreenColumn = N1 ' or Blank it out
SELECT CASE FooterSize
CASE N6, N7
F5HelpRow = N18
CASE N8
F5HelpRow = N17
CASE N9
F5HelpRow = N16
END SELECT
IF NOT FooterRecall THEN ' Show F5 Help
CALL ShowIt(N7, F5HelpRow, N1, "F5")
CALL ShowIt(N6, N0, Nm1, " Help ")
IF FooterSize = N6 THEN CALL ShowIt(N3, N25, N1, Blank80$)
GOTO AllOver
ELSE
CALL ShowIt(N3, F5HelpRow, N1, Blank8$) ' Blank F5 Help
END IF
END IF
' Instructions Refresh
CALL ShowMult(N6, N22, N1, N80, N4)
' Clear Area First
IF NOT ApptFile THEN
CALL ShowIt(N7, N23, Column1, "E")
CALL ShowIt(N6, N0, Nm1, " Use Appointment File")
ELSE
CALL ShowIt(N7, N23, Column1, "E,F3")
CALL ShowIt(N6, N0, Nm1, " Events")
END IF
CALL ShowIt(N7, N24, Column1, "D")
IF NOT OtherCalendars THEN
CALL ShowIt(N6, N0, Nm1, " Show Specific Date")
ELSE
CALL ShowIt(N6, N0, Nm1, " Show Date ")
CALL ShowIt(N7, N0, Nm1, "T")
CALL ShowIt(N6, N0, Nm1, " Today")
END IF
CALL ShowIt(N7, N25, Column1, "S")
CALL ShowIt(N6, N0, Nm1, " Sound Setting")
CALL ShowIt(N6, N22, (Column4 + N3), "Scroll:")
' West-Arrow Followed By East-Arrow
CALL ShowIt(N7, N23, Column4, _
(Blank1$ + LeftArrow$ + RightArrow$ + Blank1$))
CALL ShowIt(N6, N0, Nm1, " Calendars")
IF ApptFile THEN
CALL ShowIt(N7, Nm1, Column4, (Blank1$ + UpArrow$ + DownArrow$ + _
Blank1$))
CALL ShowIt(N6, N0, Nm1, " Notes ")
CALL ShowIt(N7, Nm1, Column4, "PgUp/Dn")
CALL ShowIt(N6, N0, Nm1, " Events")
END IF
IF ApptFile THEN
CALL ShowIt(N7, N24, Column2, "*,Print")
CALL ShowIt(N6, N0, Nm1, " Print")
CALL ShowIt(N7, N25, Column2, "End")
CALL ShowIt(N6, N0, Nm1, " Eject")
END IF
CALL ShowIt(N7, N22, Column3, "Esc")
CALL ShowIt(N6, N0, Nm1, " Menu")
CALL ShowIt(N7, N23, Column3, "Ctrl-Esc")
CALL ShowIt(N6, N0, Nm1, " Quit")
CALL ShowIt(N7, N24, Column3, "F6,F7")
CALL ShowIt(N6, N0, Nm1, " DOS")
IF NOT DOS2x THEN
CALL ShowIt(N7, N25, Column3, ("F10," + UpArrow$ + "F10"))
CALL ShowIt(N6, N0, Nm1, " Pop Down")
END IF
IF ApptFile THEN
CALL ShowIt(N7, N22, Column2, "H")
CALL ShowIt(N6, N0, Nm1, " History")
CALL ShowIt(N7, N23, Column2, "N,F4")
CALL ShowIt(N6, N0, Nm1, " Notes")
IF OverdueCount THEN
CALL ShowIt(N7, N22, Column1, "Del")
CALL ShowIt(N6, N0, Nm1, " Erase Overdue")
END IF
END IF
AllOver:
RefreshInstructions = No
Subnum = SubnumSave
END SUB
'=========================================================================
SUB KeyStuff (KeyFunction) STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 35
' General Keystroke Processing, Status Testing/Display, Key Traps
' KeyFunction is input
' KeyStatus (=1) get/display caps/num/ins/out status if chgd
' KeySingle (=2) get one keystroke and display status
' KeyWait (=3) wait for a keystroke
' KeyCursor (=4) move cursor (all locate requests)
' KeyCursorOff (=-4) move cursor, turn off, set DOS shape
' KeyNumOn (=5) enable Numlock
' KeyNumOff (=6) disable Numlock
' KeyTimerInit (=7) Initialize Timer Box (may force StatusAbs)
' KeyStatusAbs (=8) Show state flags unconditionally
' CursorRow,CursorColumn = Cursor Location
'=========================================================================
' Do is for Keystroke Waiting
' Any other call exits after one pass at Loop statement
'-------------------------------------------------------------------------
DO
'====================================================================
' Previous Exit Leaves If Exiting is Enabled -- EXITS PROGRAM !!
' (Delays Program Exit If Appointment File is Being Written)
IF ExitKeys AND KeyDelayedExit THEN CALL EndItAll
'----------------------------------------------------------------
' See if Insert Being Pressed and Released
' This overrides MhInStat just for the Insert Key
InsertKeyed = No ' Reset Insert Off Action Flag
DO
'---------------------------------------------------------------
' Get the Scan Codes if a Key is in the Keyboard Buffer
CALL MhInStat(KshiftIn%, KscanIn%, KasciiIn%)
PriorInsert = InsertPressing%
CALL MhGetKbStatus2(InsertPressing%, C%, N%, S%, A%, T%, L%, R%)
IF PriorInsert <> InsertPressing% AND _
InsertPressing% <> N0 THEN
InsertKeyed = Yes ' Due to error in MhGetKbStatus2
KscanIn% = 82 ' if MhSet on numlock has been used
KasciiIn% = N0 ' sense of insert key depends on
IF AllowInsertMode THEN
KscanIn% = N0
K$ = INKEY$
InsertKeyed = No
END IF
END IF ' so wait here for both
LOOP WHILE InsertPressing%
'---------------------------------------------------------------
' Turn Insert Mode Off if On and Not Allowed -- Automatically
CALL MhGetKbStatus1(Insrt%, C%, N%, S%, A%, T%, L%, R%)
IF Insrt% = N1 AND AllowInsertMode = No THEN
CALL MhSetKbStatus(N0%, N3%, N3%, N3%)
END IF
'----------------------------------------------------------
' Test for Exit Keys (Ctrl-Esc and Ctrl-Break)
IF (KshiftIn% AND N4) = N4 THEN ' if Ctrl was With it
IF KscanIn% = N1% OR KscanIn% = 70 THEN ' Treat Ctrl-Esc/Brk
IF ExitKeys THEN ' As an exception
CALL EndItAll ' PROGRAM ENDS!!
ELSE
KeyDelayedExit = Yes' Or Ends Delayed
K$ = INKEY$
KscanIn = N0
KasciiIn = N0
END IF
END IF
END IF
'--------------------------------------------------------------------
' POP DOWN REQUEST !!
' F10 is pop-down key for normal pop down
' Shift-F10 is pop-down key for one-time disable of auto-pop up
' Don't Let New User Become Resident Before Help is Invoked
' Delay Pop-Down if Appt File Writing is Serious
IF KasciiIn = N0 THEN
SELECT CASE KscanIn
CASE 68 ' F10
PopDown = Yes
CASE 93 ' Shift-F10
IF (KshiftIn AND N3) THEN ' (either shift key)
PopDown = Yes
AllowPopDateTimeSave = AllowPopDateTime
AllowPopDateTime = No
END IF
END SELECT
END IF
IF SrAutoPopDown AND NOT SrAutoPopDownHappened AND _
SrAutoPopDownReady THEN
PopDown = Yes
END IF
IF (PopWait OR PopDown) AND NOT DOS2x AND NOT NewGuy AND _
NOT InPopDown AND NOT SrAutoOptions THEN
IF NOT ExitKeys THEN ' If no exit
PopWait = Yes ' wait, else
ELSE
PopDown = No
PopWait = No
' If this is called from Snooze while already popping down
' then the pop down returns without doing anything.
' This avoids hangs from recursive pop down requests.
'----------------------------------------------------------
CALL StayResPopDown ' POP DOWN HERE !!
'----------------------------------------------------------
END IF
K$ = INKEY$
KscanIn% = N0
KasciiIn% = N0
ELSE
PopDown = No
PopWait = No
END IF
'---------------------------------------------------------------
IF KeyFunction = KeySingle OR KeyFunction = KeyWait THEN
'===============================================================
Keystroke$ = Blank0$ ' Discard Previous Keystroke
'===============================================================
' THIS IS WHERE ALL PROGRAM CALLS GET A KEYSTROKE
'---------------------------------------------------------------
' Assumption is that if a call asked for a keystroke,
' it used it before coming back here for ANY reason, so ...
'---------------------------------------------------------------
IF KscanIn% OR KasciiIn% OR InsertKeyed THEN
'----------------------------------------------------------
' Empty Keystroke Buffer Because There May be Something
' (Buffer can fill up if it isn't emptied every time)
' Only use of Inkey$ in this Program
' Except For Final Exit Code and Pop Down
'----------------------------------------------------------
' Reset Flag to Discard Keystroke
' Null Out Prior Keystroke if New One Asked For
' Must Assume Keystroke Acted Upon If Gotten Previously
DiscardKeystroke = No
Keystroke$ = INKEY$
'----------------------------------------------------------
' Test for Either Shift Key Pressed for Key Traps
' Also test for Ctrl-Left/Right Arrows
IF KeyTrapEnabled AND KeyShiftTrap = N0 THEN
IF KShiftIn% AND N3 THEN
SELECT CASE KscanIn%
CASE N15 ' Shift-Tab
KeyShiftTrap = N2
CASE N28 ' Shift-Return
KeyShiftTrap = N3
CASE 83, 130 ' Shift-Delete
KeyShiftTrap = N4
END SELECT
ELSEIF KShiftIn% AND N4 THEN
SELECT Case KscanIn%
CASE 116 ' Ctrl-Right-Arrow
KeyShiftTrap = N5
CASE 115 ' Ctrl-Left-Arrow
KeyShiftTrap = N6
END SELECT
END IF
' Discard Saved Keystroke if Trap was Set
IF KeyShiftTrap THEN DiscardKeystroke = Yes
END IF
'-----------------------------------------------------------
IF InsertKeyed AND NOT AllowInsertMode THEN
Keystroke$ = Blank1$ + CHR$(Ins)
END IF
'-----------------------------------------------------------
' If keystroke is a throwaway, null it out here
IF DiscardKeystroke THEN
Keystroke$ = Blank0$
END IF
'-----------------------------------------------------------
IF DebugRequested THEN ' Keystroke Debug Information
CALL ShowIt(N6, N3, N30, (STR$(KshiftIn%) + _
STR$(KscanIn%) + STR$(KasciiIn%) + _
STR$(InsertKeyed) + SPACE$(N1)))
END IF
'-----------------------------------------------------------
END IF ' End of Key Look-Ahead
'----------------------------------------------------------------
END IF ' End of Real Keystroke Function
'====================================================================
' Forced Key Changes
SELECT CASE KeyFunction ' Process Requested Actions
CASE KeyNumOff ' means disable Numlock
CALL MhSetKbStatus(N3%, N3%, N0%, N3%) ' Turn NumLock Off
CASE KeyNumOn ' means enable Numlock
CALL MhSetKbStatus(N3%, N3%, N1%, N3%) ' Turn NumLock On
CASE KeyCursor ' means turn cursor on
CursorState = N1
CASE KeyCursorOff ' means turn cursor off
CursorState = N0
END SELECT
'--------------------------------------------------------------------
' Get Current Status of CapsLock, NumLock and Insert
CALL MhGetKbStatus1(Insrt%, Caps%, Num%, S%, A%, T%, L%, R%)
'====================================================================
' Show Cursor If Requested or if state changed
IF Insrt% <> InsertHold OR CursorState <> CursorStateHold OR _
KeyFunction = KeySingle OR KeyFunction = KeyWait OR _
KeyFunction = KeyCursor OR KeyFunction = KeyCursorOff THEN
IF Insrt% = N1 THEN ' Check insert state
CursorStart = InsertCursorStart ' DOS Size Cursor
ELSE
CursorStart = OverstrikeCursorStart ' Full Cursor
END IF
LOCATE CursorRow, CursorColumn, CursorState, CursorStart, _
CursorStop
CursorStateHold = CursorState ' Save State
END IF
'====================================================================
' Update Key Status If Anything's Changed or Forced Request
IF KeyFunction >= KeyTimerInit OR KeyDelayedExit = Yes OR _
Caps% <> CapsHold OR Num% <> NumHold OR Insrt% <> InsertHold OR _
PopWait <> PopWaitHold OR MemoryResident <> ResHold THEN
'===============================================================
IF StartupScreen THEN
ClearChar$ = "═══" ' Horizontal Double Box Char
ELSEIF ClearChar$ <> SPACE$(N3) THEN
ClearChar$ = SPACE$(N3)
END IF
' Show CapsLock or NumLk Keys or Insert or Out
' in upper right corner
' Save cursor position in case we move it
IF NOT OnEditPage AND NOT ClockScreen THEN
CKey1 = Cl6f ' CKey1 = foreground if key off
CKey2 = Cl6b ' CKey2 = background if key off
ELSEIF OnEditPage THEN
IF ColorCRT THEN
CKey1 = Cl6b
CKey2 = Cl6f
ELSE
CKey1 = Cib
CKey2 = Cif
END IF
ELSEIF ClockScreen THEN
CKey1 = Cl3f
CKey2 = Cl3b
END IF
' Get Placement For Cap,Num,Ins,Wait,TSR Info
IF StartupScreen OR OnEditPage OR OnOverduePage THEN
PCRow = N1 ' Put Caps,Num,Ins, & Out at top of
PCColumn = N64 ' startup screen
PNRow = N1
PNColumn = 67
PIRow = N1
PIColumn = 70
PORow = N1
POColumn = 73
PRRow = N1
PRColumn = 76
ELSEIF InHelp THEN
PCRow = N22 ' Put Caps,Num,Ins, & Out at bottom center
PCColumn = N27
PNRow = N22
PNColumn = 31
PIRow = N22
PIColumn = 35
PORow = N22
POColumn = N39
PRRow = N22
PRColumn = N43
ELSEIF ClockScreen AND ApptFile THEN
PCRow = N11 ' Put Caps,Num,Ins, & Out over to left
PCColumn = N1 ' for clock and appointment file
PNRow = N12
PNColumn = N1
PIRow = N13
PIColumn = N1
PORow = N14
POColumn = N1
PRRow = N15
PRColumn = N1
ELSEIF ClockScreen AND NOT ApptFile THEN
PCRow = N1 ' Put Caps,Num,Ins, & Out in upper
PCColumn = 77 ' right corner
PNRow = N2
PNColumn = 77
PIRow = N3
PIColumn = 77
PORow = N4
POColumn = 77
PRRow = N5
PRColumn = 77
ELSE
PCRow = N3 ' Put Caps,Num,Ins, & Out at top of menu
PCColumn = N64
PNRow = N3
PNColumn = 67
PIRow = N3
PIColumn = 70
PORow = N3
POColumn = 73
PRRow = N3
PRColumn = 76
END IF
' Now Display CapsLock
IF Caps% <> CapsHold OR KeyFunction >= KeyTimerInit THEN
CapsHold = Caps%
IF Caps% THEN
ColorForeground = CKey2
ColorBackground = CKey1
CALL Kolors(N0)
CALL ShowIt(N0, PCRow, PCColumn, "Cap")
ELSE
ColorForeground = CKey1
ColorBackground = CKey2
CALL Kolors(N0)
CALL ShowIt(N0, PCRow, PCColumn, ClearChar$)
END IF
END IF
' Now Display NumLock
IF Num% <> NumHold OR KeyFunction >= KeyTimerInit THEN
NumHold = Num%
IF Num% THEN
ColorForeground = CKey2
ColorBackground = CKey1
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PNRow, PNColumn, "Num")
ELSE
ColorForeground = CKey1
ColorBackground = CKey2
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PNRow, PNColumn, ClearChar$)
END IF
END IF
IF InsertHold <> Insrt% OR KeyFunction >= KeyTimerInit THEN
InsertHold = Insrt%
IF Insrt% = N1 THEN
IF AllowInsertMode THEN
ColorForeground = CKey2
ColorBackground = CKey1
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PIRow, PIColumn, "Ins")
END IF
ELSE
ColorForeground = CKey1
ColorBackground = CKey2
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PIRow, PIColumn, ClearChar$)
END IF
END IF
IF MemoryResident <> ResHold OR KeyFunction >= KeyTimerInit THEN
ResHold = MemoryResident
IF MemoryResident THEN
ColorForeground = CKey2
ColorBackground = CKey1
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PORow, POColumn, "TSR")
ELSE
ColorForeground = CKey1
ColorBackground = CKey2
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PORow, POColumn, ClearChar$)
END IF
END IF
IF KeyDelayedExit = Yes OR KeyFunction >= KeyTimerInit OR _
PopWait <> PopWaitHold THEN
PopWaitHold = PopWait
IF KeyDelayedExit OR PopWait THEN
ColorForeground = (CKey2 + N16) MOD N32' Blink
ColorBackground = CKey1
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PRRow, PRColumn, "Wait")
ELSE
ColorForeground = CKey1
ColorBackground = CKey2
CALL Kolors(N0) ' Special colors
CALL ShowIt(N0, PRRow, PRColumn, _
(Strng$(N4, ASC(ClearChar$))))
END IF
END IF
END IF
'====================================================================
' Update Timer Display If Not Suppressed
IF NOT TimerDisplaySuppress THEN
TimeNow$ = TIME$ ' Save Time
IF KeyFunction = KeyTimerInit THEN
CALL Kolors(N6) ' Forced Update
CALL BoxDraw(N1, N1, N4, N1, N12)
END IF
IF TimeNow$ <> TimeHold$ OR KeyFunction = KeyTimerInit THEN
TimeHold$ = TIME$
CALL ShowIt(N6, N2, N2, DATE$)
CALL ShowIt(N0, N3, N2, (Blank1$ + TIME$ + Blank1$))
END IF
END IF
'====================================================================
IF DebugRequested and LoopCounterShow THEN 'Debug Information
Tag$ = STR$(LoopCounter) + _
STR$(MemoryLeft&) + STR$(MemoryOK&) + STR$(FRE(N0)) + _
STR$(FRE(Nm1)) + STR$(FRE(Nm2)) + _
STR$(CurrentStackSize&) + STR$(STACK) + SPACE$(N1)
CALL ShowIt(N6, N1, N30, Tag$)
Tag$ = STR$(FRE(Nm1) - _
AvailableStringSpace&) + STR$(AvailableStringSpace&) + _
STR$(KscanRes) + STR$(KshiftRes) + _
STR$(ResEcode) + STR$(SrKscanHot) + STR$(SrKshiftHot) + _
STR$(MemoryResident) + STR$(DOSCursorPage) + SPACE$(N1)
CALL ShowIt(N0, Nm1, N0, Tag$)
END IF
'====================================================================
' Wait for Keystroke if Requested
LOOP WHILE LEN(Keystroke$) = N0 AND KeyFunction = KeyWait AND _
MenuRecursiveReturn = No ' Not setting menu bypass
'=========================================================================
' Exit Here with saved keystroke from either KeySingle or KeyWait
' or if first pop down and menu refresh is needed.
'=========================================================================
Subnum = SubnumSave
END SUB
'=========================================================================
SUB KillAFile (KillFilename$) STATIC
'=========================================================================
' Change Screen Color Setting
DEFINT A-Z
SubnumSave = Subnum
Subnum = 121
Filename$ = KillFilename$
CALL MhKill((ASCIIZ$(KillFilename$)), KillEcode%)
Subnum = SubnumSave
END SUB
'=========================================================================
SUB Kolors (KSetting) STATIC
'=========================================================================
' Change Screen Color Setting
DEFINT A-Z
SubnumSave = Subnum
Subnum = 36
WhichSetting = KSetting
SELECT CASE WhichSetting
CASE 0 ' Already Defined Color, use it
CASE N1 ' Events
ColorForeground = Cl1f
ColorBackground = Cl1b
CASE N2 ' Notes
ColorForeground = Cl2f
ColorBackground = Cl2b
CASE N3 ' Clock
ColorForeground = Cl3f
ColorBackground = Cl3b
CASE N4 ' Calendars
ColorForeground = Cl4f
ColorBackground = Cl4b
CASE N5 ' Menus
ColorForeground = Cl5f
ColorBackground = Cl5b
CASE N6 ' Instructions
ColorForeground = Cl6f
ColorBackground = Cl6b
CASE N7 ' Emphasis
ColorForeground = Chf
ColorBackground = Chb
CASE N8 ' 8 to 14 are inverse of 1 to 7
ColorForeground = Cl1b
ColorBackground = Cl1f
CASE N9
ColorForeground = Cl2b
ColorBackground = Cl2f
CASE N10
ColorForeground = Cl3b
ColorBackground = Cl3f
CASE N11
ColorForeground = Cl4b
ColorBackground = Cl4f
CASE N12
ColorForeground = Cl5b
ColorBackground = Cl5f
CASE N13
ColorForeground = Cl6b
ColorBackground = Cl6f
CASE N14
IF ColorCRT THEN
ColorForeground = Chb
ColorBackground = Chf
ELSE
ColorForeground = Cib
ColorBackground = Cif
END IF
CASE N15 ' Inverse and Blinking
ColorForeground = Cl6b + N16
ColorBackground = Cl6f
CASE N16 ' Bright Inverse and Blinking
IF ColorCRT THEN
ColorForeground = Chb + N16
ColorBackground = Chf
ELSE
ColorForeground = Cib + N16
ColorBackground = Cif
END IF
CASE N17 ' White on Black
ColorForeground = N7
ColorBackground = N0
CASE N18 ' Black on White
ColorForeground = N0
ColorBackground = N7
CASE N19 ' 13 If Not Mono
IF ColorCRT THEN
ColorForeground = Cl6b
ColorBackground = Cl6f
ELSE
ColorForeground = Cib
ColorBackground = Cif
END IF
CASE N20 ' Hilit and Blinking
ColorForeground = Chf + N16
ColorBackground = Chb
CASE N99 ' DOS Colors
ColorForeground = DOSForeground
ColorBackground = DOSBackground
END SELECT
' The only use of the BASIC "Color" statement is here! --
COLOR ColorForeground, (ColorBackground MOD N8)
' So that the Current Color Attribute can be computed for the Mh routines
MhColorForeground = ColorForeground
MhColorBackground = ColorBackground
CALL MhColorAttribute(MhCAttribute%, MhColorForeground%, _
(MhColorBackground% MOD N8%)) ' >7 like QB can
ColorAttribute = MhCAttribute
Subnum = SubnumSave
END SUB
'=========================================================================
FUNCTION Leap (LeapInput) STATIC
'=========================================================================
' Check If Date Is Leap Year (Leap); Does Not Include 4000 yr Anomaly!
DEFINT A-Z
SubnumSave = Subnum
Subnum = 37
Leap = N0
IF (LeapInput MOD 4) = N0 THEN
IF (LeapInput MOD 100) = N0 THEN
IF (LeapInput MOD 400) THEN GOTO ExitPoint
END IF
Leap = N1
END IF
' Count
ExitPoint:
Subnum = SubnumSave
END FUNCTION
'=========================================================================
SUB LprintString (PrintString$, HoldPrint) 'CAN'T BE STATIC !!
'=========================================================================
' Send to Printer With Friendly Error Recovery and Paging
' PrintString$ is what to print
' HoldPrint Means Don't Space a Line
' This routine is recursive if it ejects a page in the middle of
' processing an error or page break
DEFINT A-Z
SubnumSave = Subnum
Subnum = 38
IF LprintJobOver THEN
LprintJobOver = No
OPEN "O", #FilenumCopy, "LPT1" 'Flush printer at end
CLOSE #FilenumCopy
GOTO ExitPoint2
END IF
IF LprintTerminate THEN GOTO ExitPoint2 'If existing error, out
Lin$ = PrintString$ 'Get string to print
IF HoldPrint <> N1 THEN 'If a full line,
Lin$ = Lin$ + CHR$(N13) + CHR$(N10) ' add a carriage return
END IF
PrintTheLine:
CALL MhLprint (N1%, Lin$, CharsPrinted%, LprintEcode%) 'Print it
IF LprintEcode = N0 THEN ' If okay and
IF PrinterLineLimit THEN ' If limited
IF PrinterLineCount > PrinterLineLimit THEN ' If at limit
'----------------------------------------
'This call makes this routine recursive
' but the recursion will cause an exit
' because PrinterLineCount is reset 1st
CALL PageEject ' eject page
'----------------------------------------
IF PrinterPause$ = True$ THEN ' If pausing
GOSUB ProcessErrorOrPage ' do pause
END IF
ELSE
PrinterLineCount = PrinterLineCount + 1 ' bump count
END IF
END IF
GOTO ExitPoint2 ' else out
ELSE
GOSUB ProcessErrorOrPage 'If not okay, give error
IF GetOut THEN
GOTO ExitPoint2 ' User wanted out
ELSE
GOTO PrintTheLine ' User wants to retry
END IF
END IF
'=========================================================================
' Control never passes through here
'=========================================================================
ProcessErrorOrPage:
GetOut = No
' Error or Page Break Has Occurred--Find a Place for the Message
IF InHelp THEN
CALL Kolors(N6)
CALL ClearLast4
END IF
MsgRow = N25
CALL Kolors(N16) ' Bright and Blinking
IF LprintEcode THEN
CALL MajorBeeper
EraseLine$ = _
"A Printer Error Has Occurred -- 'Esc' Terminates Print; Other Key Continues"
ELSE
CALL MinorBeeper
EraseLine$ = _
"End of Page; Change Paper -- 'Esc' Terminates Print; Other Key Continues"
END IF
CALL ShowErase(N0, MsgRow, N1, N80, EraseLine$)
CALL KeyStuff(KeyWait)
IF ClockScreen THEN
FooterRecall = Yes
FooterAction$ = Blank1$
RedisplayNotesEvents = Yes
RefreshInstructions = Yes
END IF
IF Keystroke$ = CHR$(Esc) THEN
LprintTerminate = Yes
PrinterLineCount = 1
GetOut = Yes
RETURN
ELSE
LprintTerminate = No
CALL MinorBeeper
CALL ShowErase(N16, MsgRow, N1, N80, _
(SPACE$(33) + "Resuming Print"))
END IF
IF CharsPrinted < LEN(Lin$) THEN
Lin$ = RIGHT$(Lin$, LEN(Lin$) - CharsPrinted)
GetOut = No
END IF
RETURN
ExitPoint2:
Subnum = SubnumSave
END SUB
'=========================================================================
SUB MajorBeeper STATIC
'=========================================================================
' MajorBeeper -- Beeps only if sound has been allowed
DEFINT A-Z
SubnumSave = Subnum
Subnum = 39
IF SoundLevel > N1 THEN
CALL PlayStuff("mbt255l13mlo4e-dcl9go3l5g")
END IF
Subnum = SubnumSave
END SUB
'=========================================================================
SUB MenuDriver (MMenuSize, MMenuChoice, MMenuRow, MReqMenuColumn, _
MMenuSingleLine, MMenuSpecialExit, MScreenBottomsShow, _
MFilenameShow) STATIC
'=========================================================================
' Menu Processor
DEFINT A-Z
SubnumSave = Subnum
Subnum = 40
'--------------------------------------------------------------------
' Menu Call
' MenuSpecialExit Allow Special Function Keys
' MenuChoice Menu Choice MenuExit Cancel/Prompt
' MenuRow,MenuColumn Placement Of Menu
' ReqMenuColumn is -1 if auto-center requested, Else is MenuColumn
' MenuSize Number of Menu Items
'-------------------------------------------------------------------------
MenuSize = MMenuSize
MenuChoice = MMenuChoice
MenuRow = MMenuRow
ReqMenuColumn = MReqMenuColumn
MenuSingleLine = MMenuSingleLine
MenuSpecialExit = MMenuSpecialExit
ScreenBottomsShow = MScreenBottomsShow
FilenameShow = MFilenameShow
StartMenu:
InMenu = Yes
IF FilenameShow THEN CALL DisplayApptFilename
IF ScreenBottomsShow THEN CALL ScreenBottoms
CALL KeyStuff(KeyStatusAbs)
MenuExit = MenuNormalExit
IF ReqMenuColumn = Nm1 THEN
MenuCenter = N1
MenuColumn = N1
ELSE
MenuCenter = N0
MenuColumn = ReqMenuColumn
END IF
IF MenuChoice < N1 OR MenuChoice > MenuSize THEN
MenuChoice = N1 ' Out of bounds
END IF
' Acceptance Block
IF ColorCRT THEN
MenuColorFore = Cl5f
MenuColorBack = Cl5b
ELSE
MenuColorFore = Cl1f
MenuColorBack = Cl1b
END IF
MenuChoiceInit = MenuChoice
'-------------------------------------------------------------------------
SetMenuLine:
IF NOT MenuSingleLine THEN
ThisMenuLine = N1
MenuChoice = N1
ELSE
ThisMenuLine = MenuChoice
END IF
'-------------------------------------------------------------------------
' Find Width of Menu for Box and Automatic Filling
IF NOT MenuSingleLine THEN
IF EditingNotes THEN ' 75 wide for notes/history
MenuWidth = N75
ELSEIF EditingEvents THEN ' 80 wide for events
MenuWidth = N80
ELSE ' variable for everything else
MenuWidth = N0
FOR J = N1 TO MenuSize
CALL MhNotBackwardInstr(Pointer%, N1%, (MenuLines(J)), N32%)
IF Pointer > MenuWidth THEN
MenuWidth = Pointer
END IF
NEXT
END IF
END IF
' Automatic Menu Centering If Requested (Adjusted for Spaces)
IF MenuCenter THEN MenuColumn = N1 + (76 - MenuWidth) \ N2
'=========================================================================
' Loop Through Acceptance Shells and Menu Descriptions
DO
IF WhichColor <> N0 AND ColorCRT THEN
' Special Color Effects; Set Color to Show
FOR JJJ = N1 TO MenuSize
IF LEFT$(MenuLines(ThisMenuLine), _
LEN(Colors$(JJJ))) = Colors$(JJJ) THEN
ColortoShow = JJJ - N1
END IF
NEXT
IF (WhichColor MOD N2) = N1 THEN
MenuColorFore = ColortoShow
ELSE
MenuColorBack = ColortoShow
END IF
SELECT CASE WhichColor
CASE N1
MenuColorBack = Cl1b
CASE N2
MenuColorFore = Cl1f
CASE N3
MenuColorBack = Cl2b
CASE N4
MenuColorFore = Cl2f
CASE N5
MenuColorBack = Cl3b
CASE N6
MenuColorFore = Cl3f
CASE N7
MenuColorBack = Cl4b
CASE N8
MenuColorFore = Cl4f
CASE N9
MenuColorBack = Cl5b
CASE N10
MenuColorFore = Cl5f
CASE N11
MenuColorBack = Cl6b
CASE N12
MenuColorFore = Cl6f
CASE N13
MenuColorBack = Chb
CASE N14
MenuColorFore = Chf
END SELECT
'---------------------------------------------------------------
' Handle Invisibles As Black and White, Regardless of Color
IF MenuColorFore = MenuColorBack OR _
LEFT$(MenuLines(ThisMenuLine), N1) = "<" THEN
MenuColorFore = N7
MenuColorBack = N0
'----------------------------------------------------------
' If The Carets are not There, Add Them To the Ends
IF LEFT$(MenuLines(ThisMenuLine), N1) <> "<" THEN
CALL MhNotBackwardInstr(Pointer%, N1%, _
(MenuLines(ThisMenuLine)), N32%)
MenuLines(ThisMenuLine) = "<" + _
LEFT$(MenuLines(ThisMenuLine), Pointer) + ">"
END IF
'----------------------------------------------------------
' If Adding the Carets Increases Width,
' Start The List Over Again
CALL MhNotBackwardInstr(Pointer%, N1%, _
(MenuLines(ThisMenuLine)), N32%)
IF Pointer > MenuWidth AND MenuSingleLine = No THEN
MenuWidth = Pointer
GOTO SetMenuLine
END IF
'----------------------------------------------------------
END IF
END IF
'--------------------------------------------------------------------
ColorForeground = MenuColorFore ' Fill Menu Colors
ColorBackground = MenuColorBack ' Array (Normals)
CALL Kolors(N0)
MenuColors(ThisMenuLine) = ColorAttribute
'====================================================================
' Put Box Around Menu if First Time, Not Too Big, or Not Clock or Edit
' If returning recursively, compute values but do not draw
IF (ThisMenuLine = N1 AND MenuSingleLine = No) OR _
MenuRecursiveReturn = Yes THEN
IF NOT ClockScreen AND NOT OnEditPage THEN
IF MenuWidth > 76 THEN
BoxWidth = MenuWidth
BoxType = N0
BoxX1 = MenuColumn + N1
BoxX2 = BoxX1 + BoxWidth - N1
BoxY1 = MenuRow + N1
BoxY2 = MenuRow + MenuSize
MenuFiller$ = Blank0$
ELSE
BoxWidth = N2 + MenuWidth
BoxType = N2
BoxX1 = MenuColumn
BoxX2 = BoxX1 + BoxWidth + N1
BoxY1 = MenuRow
BoxY2 = MenuRow + MenuSize + N1
MenuFiller$ = Blank1$
END IF
IF NOT MenuRecursiveReturn THEN
ColorAttribute = MenuColors(N1)
' Right Column
CALL BoxDraw(BoxType, BoxY1, BoxY2, BoxX1, BoxX2)
END IF
EntryWidth = BoxWidth
ELSE
EntryWidth = MenuWidth
MenuFiller$ = Blank0$
END IF
END IF
'====================================================================
MenuChoice = ThisMenuLine
GOSUB NormalLineShow ' Paint Current Line Normal Color
IF MenuSingleLine THEN EXIT DO
'====================================================================
IF ThisMenuLine < MenuSize THEN
ThisMenuLine = ThisMenuLine + N1
ELSE
EXIT DO
END IF
LOOP
MenuChoice = MenuChoiceInit ' Restore Current Menu Choice
'=========================================================================
WriteMenuLine:
GOSUB HilitLineShow ' Write the Current Line in the hilit color
'=========================================================================
' MenuDriver is recursive because of the one use made by StayResOptions.
' StayResPopDown causes StayResOptions to clobber another menu
' prematurely. Values are restored and control is returned here to
' begin anew. Actual menu repainting is bypassed because screen was
' already restored by the call to WindowRestore
' Accept a Keystroke. Recursive return won't give us one. We refresh
' the menu variables and come back here to try again
RecursiveReturnPoint:
MenuRecursiveReturn = No ' If pop down occurs here and it's
InMenuSave = No
CALL KeyStuff(KeyWait) ' the first ever, return switch is
IF MenuRecursiveReturn THEN GOTO StartMenu
' set, but no keystroke is returned.
SELECT CASE LEN(Keystroke$)
CASE N1 ' Length 1 Keys (Enter,Esc,Bsp,Space)
'===============================================================
SELECT CASE InString(CHR$(Enter) + CHR$(Esc) + CHR$(Bsp) + _
Blank1$, Keystroke$)
CASE N1 ' Enter
GOTO SpecialClear
CASE N2 ' Escape
GOTO MenuOut
CASE N3 ' Backspace (also Up-Arrow)
BackspaceKey:
GOSUB NormalLineShow ' Reprint Line Normal
MenuChoice = MenuChoice - N1
IF MenuChoice = N0 THEN MenuChoice = MenuSize
CASE N4 ' Space (also Down-Arrow)
SpaceBar:
GOSUB NormalLineShow
MenuChoice = MenuChoice + N1
IF MenuChoice > MenuSize THEN MenuChoice = N1
CASE ELSE ' Other Length One Keys
FOR TestCounter = N1 TO MenuSize
' Test Against Menu First Characters
TestPosition = MenuChoice + TestCounter
IF TestPosition > MenuSize THEN
TestPosition = MenuChoice + TestCounter - _
MenuSize
END IF
' First Increment Position
MenuCharTest$ = LEFT$(MenuLines(TestPosition), _
N1)
' Test Character Save
IF MenuCharTest$ >= "A" AND MenuCharTest$ _
<= "Z" THEN
' Test Against Upper Case/Lower
IF Keystroke$ = MenuCharTest$ OR _
Keystroke$ = CHR$(ASC(MenuCharTest$) + _
N32) THEN
GOTO ReprintLine
ELSE
GOTO AnotherChar
END IF
' Test Against Upper
END IF
IF MenuCharTest$ >= "a" AND _
MenuCharTest$ <= "z" THEN
' Test Against Lower
IF Keystroke$ = MenuCharTest$ OR _
Keystroke$ = CHR$(ASC(MenuCharTest$) _
- N32) THEN
GOTO ReprintLine
ELSE
GOTO AnotherChar
END IF
END IF
IF Keystroke$ = MenuCharTest$ THEN
GOTO ReprintLine
END IF
' Against Any Other
AnotherChar:
NEXT
FinishedChars:
CALL MinorBeeper
GOTO RecursiveReturnPoint
ReprintLine:
GOSUB NormalLineShow ' Reprint Line Normal
MenuChoice = TestPosition
GOTO WriteMenuLine
END SELECT
GOTO WriteMenuLine
CASE N2 ' Length 2 Keys
SELECT CASE InString(CHR$(PgUp) + CHR$(PgDn) + CHR$(F2) + _
CHR$(North) + CHR$(South) + CHR$(Ins) + _
CHR$(Del) + CHR$(HomeKey) + CHR$(EndKey), _
RIGHT$(Keystroke$, N1))
CASE N1 ' Page Up
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitPgUp
GOTO AllOver2
CASE N2 ' Page Down
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitPgDn
GOTO AllOver2
CASE N3 ' F2
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitF2
GOTO AllOver2
CASE N4 ' North
GOTO BackspaceKey
CASE N5 ' South
GOTO SpaceBar
CASE N6 ' Insert Key
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitInsert
GOTO AllOver2
CASE 7 ' Delete
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitDelete
GOTO AllOver2
CASE N8 ' Home
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitHomeKey
GOTO AllOver2
CASE N9 ' End
IF MenuSpecialExit = SpecialExitDisallowed THEN
CALL MinorBeeper
GOTO RecursiveReturnPoint
END IF
MenuSpecialExit = SpecialExitEndKey
GOTO AllOver2
CASE ELSE
GOTO FinishedChars
END SELECT
END SELECT
'-------------------------------------------------------------------------
MenuOut:
MenuExit = MenuCancelled ' Esc Key
' Enter or Escape Goes Here
'-------------------------------------------------------------------------
' Clear Special Exit
SpecialClear:
MenuSpecialExit = MenuNormalExit
'-------------------------------------------------------------------------
' Exit From Menu
AllOver2:
GOSUB NormalLineShow ' Lowlight Last Entry
IF ScreenBottomsShow THEN CALL ScreenBottomsDelete
InMenu = No
GOTO ExitPoint3
'-------------------------------------------------------------------------
' Print Current Line Normal Color
NormalLineShow:
ColorAttribute = MenuColors(MenuChoice)
CALL ShowErase(N0, (MenuRow + MenuChoice), (N1 + MenuColumn), _
EntryWidth, (MenuFiller$ + LEFT$(MenuLines(MenuChoice), MenuWidth) + _
MenuFiller$))
RETURN
'-------------------------------------------------------------------------
' Print Current Line Hilit -- Various Solutions to This!
HilitLineShow:
IF MonoCRT AND NOT OnEditPage THEN ' Mono hilit
CALL Kolors(N14) ' other than edit
ELSE
ColorAttribute = MenuColors(MenuChoice)
CALL ColorDecode(ColorAttribute)
IF ColorForeground = ColorBackground THEN ' Invisibles
CALL Kolors(N16) ' Black on White
ELSEIF WhichColor <> N0 AND ColorCRT THEN ' Specials Blink
ColorForeground = (ColorForeground MOD N16) + N16'on current line
CALL Kolors(N0)
ELSE
SWAP ColorForeground, ColorBackground ' All Others
CALL Kolors(N0) ' reverse
END IF
END IF
CALL ShowErase(N0, (MenuRow + MenuChoice), (N1 + MenuColumn), _
EntryWidth, (MenuFiller$ + LEFT$(MenuLines(MenuChoice), MenuWidth)))
RETURN
ExitPoint3:
MMenuChoice = MenuChoice
MMenuSpecialExit = MenuSpecialExit
Subnum = SubnumSave
END SUB
'=========================================================================
SUB MinorBeeper STATIC
'=========================================================================
' MinorBeeper -- Beeps only if sound has been allowed
DEFINT A-Z
SubnumSave = Subnum
Subnum = 41
IF SoundLevel > N1 THEN
CALL PlayStuff("mbt255l14o3mlbec#")
END IF
Subnum = SubnumSave
END SUB
'=========================================================================
SUB MoveApptRecords (FileStart, MoveStart, MoveEnd, MoveIncr, _
MoveOrigin, MoveTarget, MoveFlag, BlankFlag, BlankAt) STATIC
'=========================================================================
'Routine To Move Records Up Or Down In File A Fixed Amount
' (MoveOrigin to MoveTarget from FileStart
' Backwards or Forwards (MoveIncr)
' Starting From MoveStart, Ending With MoveEnd
DEFINT A-Z
SubnumSave = Subnum
Subnum = 42
CALL ShowErase(N14, N25, N1, N80, _
" Please Wait--Moving Records in Appointment File")
FOR Mover = MoveStart TO MoveEnd STEP MoveIncr
CALL KeyStuff(KeyStatus)
MovSt = ABS(MoveEnd - Mover + N1)
CALL ShowIt(N14, N25, N60, (STR$(MovSt) + SPACE$(N4)))
MovePoint = FileStart + Mover - N1
' MoveFlag Must Be 1 to Copy Record To New Location
IF MoveFlag = N1 THEN
CALL GetApptRecord(MovePoint + MoveOrigin)
CALL PutApptRecord(MovePoint + MoveTarget)
END IF
' BlankFlag Must Be 1 to Blank BlankAt Location
IF BlankFlag = N1 THEN
CALL MhLset(ApptBuffer$, Blank80$)
CALL PutApptRecord(MovePoint + BlankAt)
END IF
NEXT
Subnum = SubnumSave
END SUB
'=========================================================================
SUB Myd2 (Destin$, DestinStart%, Chars%, Source$) STATIC
'=========================================================================
' Replacement for MID$ Statement--whole source to partial destination
DEFINT A-Z
SubnumSave = Subnum
Subnum = 122
' Doesn't define output string length
CALL MhMidString (Destin$, DestinStart%, Chars%, Source$, N1%)
Subnum = SubnumSave
END SUB
'=========================================================================
SUB NotesHistory (NotesorHistory$) STATIC
'=========================================================================
' Process History Or Note Editing Request
DEFINT A-Z
SubnumSave = Subnum
Subnum = 43
'History/Note Variables- LastRecord Last Relative Record
'(2 for notes) LastPage Last Relative Page
' (starting with 0)
'(1 to end) CurrentHistory Current Relative
' History Record
'(1 to NumberofNotes) CurrentNote Current Relative
' Note Record
'(1 to end) CurrentNoteHist Current Relative Record
'(page has 20 recs) CurrentPage Current Relative Page
' (0 on)
'(1 to end) ApptFileRec Current Absolute
' Record Number In File
'(StartingNote or StartingHistory) FileStart
' Starting Absolute Record Number In File
'( 62 Default) StartingNote Starting Absolute
' Note Record Number
'(122 Default) StartingHistory Starting Absolute
' History Record Number
' NotesorHistory$ ("N") or ("H")
'-------------------------------------------------------------------------
' Initialize parameters, Display History Only If Some Is There
StartAll:
ExitKeys = Yes
GOSUB SetupNotes
IF NotesorHistory$ = "H" AND LOF(FilenumAppt) \ N80 < StartingHistory THEN
CALL MinorBeeper
Menu1 = MainMenuLastEntry
GOTO ExitPoint4
END IF
MenuSingleLine = No
IF NOT OnScreen THEN
MenuRow = N1
CALL Kolors(N5)
TimerDisplaySuppress = Yes
CLS
OnEditPage = Yes
ClockScreen = No
CALL ShowErase(N19, N1, N6, N75, "Change ")
IF NotesorHistory$ = "H" THEN
CALL ShowIt(N0, N0, Nm1, "History")
ELSE
CALL ShowIt(N0, N0, Nm1, "Notes")
END IF
ELSE
MenuRow = N17
IF FooterSize >= N6 THEN
CALL ShowIt(N3, F5HelpRow, N1, Blank8$) ' Clear F5 Prompt
END IF
CALL ShowIt(N3, N17, N1, Blank80$) ' Clear Row Above Edit
END IF
'-------------------------------------------------------------------------
' Fill a Menu's Worth of History or Notes
FOR JJ = N1 TO EditPagesize
CALL KeyStuff(KeyStatus)
IF (EditPagesize * CurrentPage + JJ) > LastRecord THEN EXIT FOR
JT = JJ
' Get Note/History Number and Right Justify It
EditLineLabel$ = STR$(JJ + EditPagesize * CurrentPage)
LenTemp = LEN(EditLineLabel$) - N1 ' Less the leading space
IF LenTemp > N4 THEN LenTemp = N4 ' Only the right 4 chars
EditLineLabel$ = SPACE$(N4 - LenTemp) + _
RIGHT$(EditLineLabel$, LenTemp) + Blank1$
CALL ShowIt(N13, (MenuRow + JJ), N1, EditLineLabel$)
' Get Note or History Text
ApptFileRec = FileStart + JJ + EditPagesize * CurrentPage - N1
CALL GetApptRecord(ApptFileRec)
'--------------------------------------------------------------------
' Each Entry Is Filled Or Nulled
MenuLines(JJ) = MID$(ApptBuffer$, N1, N75)
NEXT
MenuSize = JT
'-------------------------------------------------------------------------
' Set Up For Editing--Back To Clock When Finished
StartEdit:
ExitKeys = Yes
IF NOT OnScreen OR OnScreenFirst THEN
FOR I = N1 TO N4
CALL ShowIt(N14, N21 + I, N1, NoteInstructions1(I))
NEXT
FOR I = N1 TO N3
CALL ShowIt(N9, N22 + I, N28, NoteInstructions2(I))
NEXT
CALL ShowIt(N0, N22, N0, NoteInstructions3)
FOR I = N1 TO N3
CALL ShowIt(N19, N22 + I, N50, EventNoteSharedIns(I))
NEXT
OnScreenFirst = No
END IF
MenuSpecialExit = SpecialExitAllowed
MenuChoice = CurrentNoteHist - (EditPagesize * CurrentPage)
EditingNotes = Yes
CALL MenuDriver(MenuSize, MenuChoice, MenuRow, N5, _
MenuSingleLine, MenuSpecialExit, N0, N0)
EditingNotes = No
IF MenuExit = MenuCancelled THEN
IF OnScreen THEN
ScreenMultRow = MenuRow + N1
CALL ShowMult(N3, ScreenMultRow, N1, N80, N8)
RefreshInstructions = Yes
RedisplayNotesEvents = Yes
ELSEIF NotesorHistory$ = "N" THEN
CurrentNote = N1
END IF
NoHistEndDefault = No
MenuSingleLine = No
Menu1 = MainMenuLastEntry
' Flush I/O Buffers for Safety By Closing and Opening File
CALL OpenAppts
GOTO ExitPoint4
END IF
'-------------------------------------------------------------------------
' Calculate Relative Record From Start of History/Notes
' Save It In History or Notes Relative Record
CurrentNoteHist = MenuChoice + EditPagesize * CurrentPage
IF NotesorHistory$ = "H" THEN
CurrentHistory = CurrentNoteHist
ELSE
CurrentNote = CurrentNoteHist
END IF
'-------------------------------------------------------------------------
' Refresh Parameters--Process Result of Editing
GOSUB SetupNotes
MenuSingleLine = Yes
SELECT CASE MenuSpecialExit
CASE SpecialExitDisallowed ' Return
' "Enter" A Change--First Write Deleted Note Record To History
GOSUB DeletedToHistory
'---------------------------------------------------------------
' Type In The Changed Data For A Line Of History Or Notes
IF ClockScreen THEN CALL Kolors(N3) ELSE CALL Kolors(N5)
CALL ClearLast4
FOR I = N1 TO N4
CALL ShowIt(N14, N21 + I, N34, NoteInput(I))
NEXT
BoxRow = MenuRow + MenuChoice
InputResponse$ = LEFT$(MenuLines(MenuChoice), N75)
CALL ControlledInput(BoxRow, N6, BoxRow, N6, N75, _
Blank0$, InputResponse$, N0, N0, N0, N1)
MenuLines(MenuChoice) = InputResponse$
OnScreenFirst = Yes
'---------------------------------------------------------------
' Rewrite The Record In The File And Do It Again
CALL MhLset(ApptBuffer$, (MenuLines(MenuChoice)))
CALL PutApptRecord(ApptFileRec)
GOTO StartEdit
'---------------------------------------------------------------
' Write A Deleted Note Record To History
DeletedToHistory:
IF NotesorHistory$ <> "H" AND MenuLines(MenuChoice) <> Blank80$ _
AND MID$(MenuLines$(MenuChoice), N1, N71) <> SPACE$(N71) THEN
EventtoHistory = No
HistoryBuffer$ = LEFT$(MenuLines(MenuChoice), N71) + _
SPACE$(N9)
CALL WritetoHistory
END IF
GOSUB SetupNotes
RETURN
'---------------------------------------------------------------
CASE SpecialExitInsert ' Insert
' "Insert" One Or More Lines
' --Find Out How Many (InsCount)
' If Too Many Lines On Notes,
' Set Number Of Lines To Difference To End
CALL ClearLast4
InsCount = N0
InputResponse$ = MID$(STR$(InsCount), N2, N4)
CALL ControlledInput(N23, N32, N23, N5, N4, _
"How Many Lines To Insert?", InputResponse$, _
N1, N0, N1, N1)
CALL ClearLast4
InsCount = VAL(InputResponse$)
IF NotesorHistory$ = "N" AND _
CurrentNoteHist + InsCount > LastRecord + N1 THEN
InsCount = LastRecord - CurrentNoteHist + N1
END IF
'---------------------------------------------------------------
' If Notes And Inserting Before Last Record, Just Blank It Out
IF OnScreen THEN OnScreenFirst = Yes
IF InsCount <= N0 OR Keystroke$ = CHR$(Esc) THEN
CALL MinorBeeper
GOTO StartAll
END IF
ExitKeys = No
IF NotesorHistory$ = "N" AND CurrentNoteHist = LastRecord THEN
MenuSingleLine = Yes
GOSUB DeleteSingle
GOTO StartEdit
END IF
IF NotesorHistory$ = "N" THEN
'----------------------------------------------------------
' If Notes And Before Last Record,
' Put Each Off-End Record To History
' Then Blank Out Place
' Where It Came From (Effect Of Insert)
FOR JJ = InsCount TO N1 STEP Nm1
CALL KeyStuff(KeyStatus)
Pointer = StartingNote + LastRecord - JJ
CALL GetApptRecord(Pointer)
IF ApptBuffer$ <> Blank80$ THEN
Pointer = LOF(FilenumAppt) \ N80 + N1
CALL PutApptRecord(Pointer)
CALL MhLset(ApptBuffer$, Blank80$)
Pointer = StartingNote + LastRecord - JJ
CALL PutApptRecord(Pointer)
END IF
NEXT
' Then Move Each Non-Off-End Note Record Down In The File
' InsCount Lines
MoveEnd = CurrentNoteHist + InsCount
CALL MoveApptRecords(FileStart, LastRecord, MoveEnd, _
Nm1, -InsCount, N0, N1, N1, -InsCount)
ELSE
'----------------------------------------------------------
' If History,
' Just Move Each Record Down InsCount Places
' In The File
' First From The End Back To The Last Back To The Current
MoveEnd = CurrentNoteHist
CALL MoveApptRecords(FileStart, LastRecord, _
MoveEnd, Nm1, N0, InsCount, N1, N1, N0)
' And Then Blank Out The Area Moved
' Out Of InsCount Places
MoveEnd = CurrentNoteHist + InsCount - N1
CALL MoveApptRecords(FileStart, LastRecord + N1, _
MoveEnd, N1, N0, N0, N0, N1, N0)
END IF
GOTO StartAll
'----------------------------------------------------------------
' Delete A Single History Or Note Record ApptFileRec
DeleteSingle:
GOSUB DeletedToHistory
CALL Myd2(MenuLines(MenuChoice), N1, N71, SPACE$(N71))
CALL MhLset(ApptBuffer$, Blank80$)
CALL PutApptRecord(ApptFileRec)
RETURN
'----------------------------------------------------------------
CASE SpecialExitDelete ' Delete
'---------------------------------------------------------------
' Delete Records--Determine How Many Lines To Delete
' If More Than Difference End To Current, Limit It
CALL ClearLast4
DelCount = N0
InputResponse$ = MID$(STR$(DelCount), N2, N4)
CALL ControlledInput(N23, N32, N23, N5, N4, _
"How Many Lines To Delete?", InputResponse$, _
N1, N0, N1, N1)
CALL ClearLast4
DelCount = VAL(InputResponse$)
IF DelCount > LastRecord - CurrentNoteHist + N1 THEN
DelCount = LastRecord - CurrentNoteHist + N1
END IF
IF OnScreen THEN OnScreenFirst = Yes
' If Notes And Deleting Last Record,
' Just Write History & Blank It Out
ExitKeys = No
IF DelCount <= N0 OR Keystroke$ = CHR$(Esc) THEN
CALL MinorBeeper
GOTO StartAll
ELSEIF NotesorHistory$ = "N" AND _
CurrentNoteHist = LastRecord THEN
MenuSingleLine = Yes
GOSUB DeleteSingle
GOTO StartEdit
END IF
IF NotesorHistory$ = "N" THEN
'----------------------------------------------------------
' If Notes, Put Each Deleted Record To History,
' And Blank It Out
FOR JJ = N1 TO DelCount
CALL KeyStuff(KeyStatus)
Pointer = StartingNote - N2 + JJ + CurrentNoteHist
CALL GetApptRecord(Pointer)
IF ApptBuffer$ <> Blank80$ THEN
HistoryBuffer$ = ApptBuffer$
EventtoHistory = No
CALL WritetoHistory
CALL MhLset(ApptBuffer$, Blank80$)
Pointer = StartingNote - N2 + JJ + _
CurrentNoteHist
CALL PutApptRecord(Pointer)
END IF
NEXT
END IF
'---------------------------------------------------------------
' Then Move Each Record Backwards In The File
' DelCount Places
' Blanking The Place Where It Came From
MoveStart = CurrentNoteHist + DelCount
CALL MoveApptRecords(FileStart, MoveStart, LastRecord, _
N1, N0, -DelCount, N1, N1, N0)
IF NotesorHistory$ = "N" THEN GOTO StartAll
' Then If Its History, Compress The File
' Down DelCount+Null Records
CALL CompressApptFile(DelCount)
GOTO StartAll
CASE SpecialExitPgUp ' Page Up
IF CurrentPage < N1 THEN
CurrentPage = N0
GOTO ErrorBeep
ELSE
CurrentPage = CurrentPage - N1
GOTO ChangePage
END IF
CASE SpecialExitPgDn ' Page Down
IF CurrentPage >= LastPage THEN
CurrentPage = LastPage
GOTO ErrorBeep
ELSE
CurrentPage = CurrentPage + N1
GOTO ChangePage
END IF
CASE SpecialExitF2 ' F2
CALL MinorBeeper
GOTO StartAll
CASE SpecialExitHomeKey ' Home
IF CurrentPage < N1 THEN
CurrentPage = N0
GOTO ErrorBeep
ELSE
CurrentPage = N0
GOTO ChangePage
END IF
CASE SpecialExitEndKey ' End
IF CurrentPage >= LastPage THEN
CurrentPage = LastPage
GOTO ErrorBeep
ELSE
CurrentPage = LastPage
END IF
' Reset Record Indicators And Go To That Page
ChangePage:
CurrentNoteHist = N1 + EditPagesize * CurrentPage
IF NotesorHistory$ = "H" THEN
CurrentHistory = CurrentNoteHist
ELSE
CurrentNote = CurrentNoteHist
END IF
GOTO StartAll
CASE ELSE ' F2
CALL MinorBeeper
GOTO StartAll
END SELECT
'-------------------------------------------------------------------------
' Set The Current Parameters Up For Notes, Default Notes To Beginning
' Start Record, End Page, End Relative Record, Current Relative Record
SetupNotes:
IF NotesorHistory$ = "N" THEN
FileStart = StartingNote
LastRecord = NumberofNotes
IF CurrentNote <= N0 THEN
CurrentNote = N1
ELSEIF CurrentNote > LastRecord THEN
CurrentNote = LastRecord
END IF
LastPage = NumberofNotes \ EditPagesize - N1
CurrentNoteHist = CurrentNote
ELSE
' Set The Current Parameters Up For History, Default History To End
' Start Record, End Page, End Relative Record,
' Current Relative Record
FileStart = StartingHistory
' Hist Page = 20
LastPage = ((LOF(FilenumAppt) \ N80) - StartingHistory) \ N20
LastRecord = LOF(FilenumAppt) \ N80 - StartingHistory + N1
IF NOT NoHistEndDefault THEN
CurrentHistory = LastRecord
ELSEIF CurrentHistory <= N0 OR CurrentHistory > LastRecord THEN
CurrentHistory = LastRecord
END IF
CurrentNoteHist = CurrentHistory
END IF
CurrentPage = (CurrentNoteHist - N1) \ EditPagesize
ApptFileRec = FileStart + CurrentNoteHist - N1
NoHistEndDefault = Yes
RETURN
'-------------------------------------------------------------------------
' Error Return At MenuDriver Response
ErrorBeep:
CALL MinorBeeper
GOTO StartEdit
ExitPoint4:
EditingNotes = No
Subnum = SubnumSave
END SUB
'=========================================================================
FUNCTION NumberError (NumberTest$) STATIC
'=========================================================================
' Numeric Value Tester for Strings, Returns NumberError =0 good <>0 bad
DEFINT A-Z
SubnumSave = Subnum
Subnum = 44
NumberLength = LEN(NumberTest$)
NumberError = N0
FOR WhichDigit = N1 TO NumberLength
IF InString("0123456789", _
MID$(NumberTest$, WhichDigit, N1)) = N0 THEN
NumberError = N1
EXIT FOR
END IF
NEXT
Subnum = SubnumSave
END FUNCTION
'=========================================================================
SUB OpenAppts STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 45
CALL CloseFiles
OPEN "R", FilenumAppt, ApptFilename$ + ".cld", N80
' For Appointment File, Use ApptBuffer$ As Random 80-Character Buffer
FIELD FilenumAppt, N80 AS ApptBuffer$
ApptFile = Yes
ApptFilenameOverdue$ = LTRIM$(RTRIM$(ApptFilename$)) + ".clv"
Subnum = SubnumSave
END SUB
'=========================================================================
SUB Options STATIC
'=========================================================================
' Process Options Change Request
DEFINT A-Z
SubnumSave = Subnum
Subnum = 46
CALL GetOptions
NewScreen:
DirectReturn = Yes
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Options for Appointment File"
CALL Titles(N1)
IF FooterRecallMsg$ = True$ THEN
CALL PrepareforMessage
CALL ShowIt(N0, N0, N0, _
"Clock Screen Help Instructions Will Be Suppressed--Use F5 To Recall Them")
END IF
MenuLines(N1) = "Number Of Clock Footer Lines To Display Events And" + _
" Notes, Currently " + RIGHT$(STR$(FooterSize), N1)
MenuLines(N2) = "Number Of Note Lines To Display, Currently " + _
RIGHT$(STR$(NoteSize), N1)
ScreenTag$ = SoundLevels$(SoundLevel)
MenuLines(N3) = _
"Condition Of Sound On First Entry, Currently " + ScreenTag$
MenuLines(N4) = "Music Options"
MenuLines(N5) = "Appointment File Password"
IF WeekendScheduling$ <> True$ THEN
ScreenTag$ = Noo$
ELSE
ScreenTag$ = Yess$
END IF
MenuLines(N6) = _
"Allow Daily Events To Occur On Weekends, Currently " + ScreenTag$
MenuLines(N7) = _
"Minutes of Warning for Pending Events, Currently " + RIGHT$(STR$(Pending), N2)
IF NOT InclNotes THEN ScreenTag$ = Noo$ ELSE ScreenTag$ = Yess$
MenuLines(N8) = _
"Include Notes In Print Or ASCII File, Currently " + ScreenTag$
IF NOT InclHistory THEN ScreenTag$ = Noo$ ELSE ScreenTag$ = Yess$
MenuLines(N9) = "Include History In Print Or ASCII File, Currently " + _
ScreenTag$
IF WeekBreak$ <> True$ THEN ScreenTag$ = Noo$ ELSE ScreenTag$ = Yess$
MenuLines(N10) = _
"Break Between Weeks In Print Or ASCII File, Currently " + ScreenTag$
MenuLines(N11) = "Set 1 or 2 Event Texts to Exclude From History Recording"
MenuLines(N12) = "Choose Printer Type or Set Page Size/Break"
MenuLines(N13) = _
"Change Event Capacity In Appointment File, Currently" + STR$(NumberofEvents)
MenuLines(N14) = _
"Change Note Capacity In Appointment File, Currently" + STR$(NumberofNotes)
' Options Menu Choice
CALL MenuDriver(N14, Menu4, N6, Nm1, No, N0, N1, N1)
FooterRecallMsg$ = False$
IF MenuExit = MenuCancelled THEN
CALL SetOptions
CALL GetOptions
CALL ClearScreenNormal(N1)
Menu1 = MainMenuLastEntry
' Flush I/O Buffers for Safety
CALL OpenAppts ' By Closing and Opening File
GOTO ExitPoint5
END IF
SELECT CASE Menu4
CASE N1 ' Clock Footer Size
'====================================================================
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Select Desired Clock Footer Size"
ScreenTitles$(N2) = "For Both Events And Notes"
ScreenTitles$(N3) = "(Footer Sizes 6 through 9"
ScreenTitles$(N4) = "Suppress Clock Screen Instructions)"
CALL Titles(N4)
FOR JJ = N3 TO N9
MenuLines(JJ - N2) = MID$(STR$(JJ), N2, N1)
NEXT
MenuChoice = FooterSize - N2
CALL MenuDriver(N7, MenuChoice, N6, Nm1, No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
FooterSize = MenuChoice + N2
IF FooterSize > N5 THEN FooterRecallMsg$ = True$
' Must Have At Least N1 Event
IF (NoteSize + N1) > FooterSize THEN NoteSize = FooterSize - N1
'====================================================================
CASE N2 ' Note Window Size
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Select Size Of"
ScreenTitles$(N2) = "Note Area In Footer"
CALL Titles(N2)
FOR JJ = N1 TO FooterSize ' 0 is also allowed
MenuLines(JJ) = MID$(STR$(JJ - N1), N2, N1)
NEXT
MenuChoice = NoteSize + N1
CALL MenuDriver(FooterSize, MenuChoice, N6, Nm1, _
No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
NoteSize = MenuChoice - N1
'====================================================================
CASE N3 ' Initial Sound Setting
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Set Initial Condition of Sound"
CALL Titles(N1)
MenuLines(N1) = "Totally Silent"
MenuLines(N2) = "Errors Only"
MenuLines(N3) = "Alarms, Warnings, and Errors"
MenuLines(N4) = "Chimes, Alarms, Warnings, and Errors"
CALL MenuDriver(N4, SoundLevel, N6, Nm1, No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
'====================================================================
CASE N4 ' Music Changes
MusicOption:
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Music Options"
CALL Titles(Nm1)
MenuLines(N1) = _
"Music That Is Played When a Pending Event Warning Occurs"
MenuLines(N2) = _
"Music That Is Played When Event Alarm Occurs"
MenuLines(N3) = _
"Music That Is Played When Hour Clock Chime Sounds"
CALL MenuDriver(N3, MusicOption, N6, Nm1, No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
CALL ReadCalmusic
' Get Current Music Values
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Set Music Choices"
CALL Titles(Nm1)
CALL ShowIt(N6, N8, N1, "Make Changes To PLAY String For ")
SELECT CASE MusicOption
CASE N1
CALL ShowIt(N0, N0, Nm1, "Pending Event Warning")
CASE N2
CALL ShowIt(N0, N0, Nm1, "Alarms")
CASE N3
CALL ShowIt(N0, N0, Nm1, "Chimes")
END SELECT
CALL ShowIt(N0, N9, N1, _
"(Consult PLAY Statement In IBM or Microsoft BASIC Reference Manual For Use)")
CALL ShowIt(N0, Nm1, N0, _
"(Errors Are Detected Only If Sound Options Allow Music To Be Played)")
GOSUB WhichMusic
GOTO ProcessMistake
WhichMusic:
SELECT CASE MusicOption
CASE N1
PlayString$ = Warning$
CASE N2
PlayString$ = Alarm$
CASE N3
PlayString$ = Chime$
END SELECT
CALL ShowIt(N7, N12, N1, PlayString$)
ErrorSwitch = No
SELECT CASE MusicOption
CASE N1, 2
IF SoundLevel > N2 THEN CALL PlayStuff(PlayString$)
CASE N3
IF SoundLevel > N3 THEN CALL PlayStuff(PlayString$)
END SELECT
IF ErrorSwitch THEN
ErrorSwitch = No
CALL PrepareforMessage
CALL MajorBeeper
CALL ShowIt(N0, N0, N0, _
("There is a Mistake in Your PLAY String -- " + "Correct it and Try Again"))
END IF
RETURN
ProcessMistake:
SELECT CASE MusicOption
CASE N1
InputResponse$ = Warning$
CASE N2
InputResponse$ = Alarm$
CASE N3
InputResponse$ = Chime$
END SELECT
CALL ControlledInput(N12, N1, N12, N1, N80, Blank0$, _
InputResponse$, N0, N1, N1, N1)
CALL BlankFatal
SELECT CASE MusicOption
CASE N1
Warning$ = InputResponse$
CASE N2
Alarm$ = InputResponse$
CASE N3
Chime$ = InputResponse$
END SELECT
' Write the Result if Finished, Else Try Again
IF CHR$(Esc) = RIGHT$(Keystroke$, N1) THEN
CALL WriteCalmusic
GOTO MusicOption
END IF
GOSUB WhichMusic
GOTO ProcessMistake
'====================================================================
CASE N5 ' Appointment File Password Change
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Change Appointment File Password"
CALL Titles(N1)
CALL ShowIt(N6, N6, N1, "Enter New Password")
InputResponse$ = Blank8$
CALL ControlledInput(N8, N1, N8, N22, N8, _
"Change Password To: ", InputResponse$, N0, N1, N1, N1)
EnteredPassword$ = InputResponse$
IF CHR$(Enter) = RIGHT$(Keystroke$, N1) THEN
ApptPassword$ = EnteredPassword$
END IF
'====================================================================
CASE 6 ' Weekend Rescheduling of Dailies
IF WeekendScheduling$ <> True$ THEN
WeekendScheduling$ = True$
ELSE
WeekendScheduling$ = False$
END IF
'====================================================================
CASE N7 ' Warning Time
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Select Minutes of Warning"
ScreenTitles$(N2) = "For Pending Events"
ScreenTitles$(N3) = "(Selecting 0 Means that"
ScreenTitles$(N4) = "No Warning Is Given)"
CALL Titles(N4)
PendingHold = Pending
InputResponse$ = MID$(STR$(Pending), N2, N2)
CALL ControlledInput(N12, N60, N12, N20, N2, _
"Enter Minutes of Warning (0 to 99)", InputResponse$, N1, N1, N1, N1)
IF Keystroke$ = CHR$(Esc) THEN GOTO NewScreen
Pending = VAL(InputResponse$)
IF Pending <> PendingHold THEN ' If a different warning time
EventTableStable = No ' then rebuild alarm table
END IF ' because warnings no good
'====================================================================
CASE N8 ' Notes in Print/Copy
IF NOT InclNotes THEN
InclNotes = Yes
ELSE
InclNotes = No
END IF
'====================================================================
CASE N9 ' History in Print/Copy
IF NOT InclHistory THEN
InclHistory = Yes
ELSE
InclHistory = No
END IF
'====================================================================
CASE N10 ' Week Break in Print/Copy
IF WeekBreak$ <> True$ THEN
WeekBreak$ = True$
ELSE
WeekBreak$ = False$
END IF
'====================================================================
CASE N11 ' History Exclusion of Events
CALL ReadCalexcl
' Get Exclude Text Values
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Specify Event Exclusions From History"
CALL Titles(Nm1)
CALL ShowIt(N6, N6, N1, _
"Enter Event Text to Exclude From History Recording")
CALL ShowIt(N0, Nm1, N0, _
" (Blank if No Exclusions are Desired)")
CALL ShowIt(N0, Nm1, N0, _
" All Other Event Text is Recorded in History")
FOR J = N1 TO N2
BoxRow = N11 + N4 * J
MessageRow = N9 + N4 * J
MessageText$ = "Text" + STR$(J) + ":"
InputResponse$ = ExcludefromHistory$(J)
CALL ControlledInput(BoxRow, N1, MessageRow, N15, TextSize, _
MessageText$, InputResponse$, N0, N1, N1, N1)
IF Keystroke$ = CHR$(Esc) THEN GOTO NewScreen 'Early Exit
ExcludefromHistory$(J) = InputResponse$
NEXT
' Write the Result
CALL WriteCalexcl
'====================================================================
CASE N12 ' Printer Type Choice and Paging
PrinterScreen:
CALL ClearScreenNormal(N1)
ScreenTitles$(N1) = "Choose Printer / Set Paging"
CALL Titles(N1)
MenuLines(N1) = "Epson FX Printer or Emulated Equivalent"
MenuLines(N2) = "IBM PC 4-Band Color Printer"
MenuLines(N3) = "HP IIP, III, or IIID LaserJet Printer"
MenuLines(N4) = "IBM 4019-E01 or 4019-001 LaserPrinter"
MenuLines(N5) = "Don't Send Printer Initialization Parameters"
MenuLines(N6) = "Change Printer Page Length, Currently" + _
STR$(PrinterLineLimit) + " Lines"
IF PrinterPause$ <> True$ THEN
ScreenTag$ = Noo$
ELSE
ScreenTag$ = Yess$
END IF
MenuLines(N7) = "Set Pause Between Pages, Currently " + _
ScreenTag$
MenuChoice = InString(AvailablePrinters$, SelectedPrinter$)
IF MenuChoice = N0 THEN MenuChoice = N1 ' Epson Default
CALL MenuDriver(LEN(AvailablePrinters$) + N2, MenuChoice, _
N6, Nm1, No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
SELECT CASE MenuChoice
CASE N1 TO LEN(AvailablePrinters$) 'Printer Choice
SelectedPrinter$ = MID$(AvailablePrinters$, _
MenuChoice, N1)
CASE MenuSize - N1 'Page Length
SetLineLimit:
CALL PrepareForMessage
CALL ShowIt(N0, N0, N0, _
"Enter Number of Print Lines Per Page (0 means no paging and no pause)")
InputResponse$ = MID$(STR$(PrinterLineLimit), N2, N2)
BoxRow = MenuRow + MenuSize + N5
MessageRow = BoxRow
CALL ControlledInput(BoxRow, N60, MessageRow, N20, _
N2, "Enter Printer Line Limit (0 to 99)", InputResponse$, N1, N1, N1, N1)
IF Keystroke$ = CHR$(Esc) THEN GOTO NewScreen
PrinterLineLimit = VAL(InputResponse$)
CALL BlankError
CASE MenuSize 'Page Break
IF PrinterPause$ = True$ THEN 'Toggle
PrinterPause$ = False$
ELSE
PrinterPause$ = True$
IF PrinterLineLimit = 0 THEN
GOTO SetLineLimit
END IF
END IF
END SELECT
'====================================================================
CASE N13, N14 ' Event/Note Capacity In Appointment File
CALL ClearScreenNormal(N1)
IF Menu4 = N13 THEN
ScreenTitles$(N1) = "Change Number of Events"
MenuChoice = (NumberofEvents \ N20)
ELSE
ScreenTitles$(N1) = "Change Number of Notes"
MenuChoice = (NumberofNotes \ N20)
END IF
ScreenTitles$(N2) = "In Appointment File"
CALL Titles(N2)
WhichExpansion$ = Blank1$
OldNumberEvents = NumberofEvents
OldNumberNotes = NumberofNotes
OldMenuChoice = MenuChoice
IF MenuChoice > N1 THEN
CALL ShowIt(N7, N9, N1, " Warning! -- ")
CALL ShowIt(N0, Nm1, N0, " If You Pick A Smaller ")
CALL ShowIt(N0, Nm1, N0, " Size, Then The Extra ")
CALL ShowIt(N0, Nm1, N0, " Entries At The End Of ")
CALL ShowIt(N0, Nm1, N0, " The List Will Be ")
CALL ShowIt(N0, Nm1, N0, " Written To History! ")
END IF
FOR JJ = N1 TO LEN(ValidSizes$)
MenuLines(JJ) = RIGHT$(STR$(N20 * JJ), Nm1 + _
LEN(STR$(N20 * JJ)))
NEXT
MenuSize = LEN(ValidSizes$)
CALL MenuDriver(MenuSize, MenuChoice, N6, Nm1, _
No, N0, N1, N1)
IF MenuExit = MenuCancelled THEN GOTO NewScreen
IF Menu4 = N13 THEN
NumberofEvents = N20 * MenuChoice
WhichExpansion$ = "e"
ELSE
NumberofNotes = N20 * MenuChoice
WhichExpansion$ = "n"
END IF
IF MenuChoice <> OldMenuChoice THEN
CALL Kolors(N6)
CALL ClearLast4
CALL FileFormat ' Sets Options
END IF
'====================================================================
END SELECT
'-------------------------------------------------------------------------
IF PrinterLineLimit = 0 THEN
PrinterPause$ = False$
END IF
GOTO NewScreen
ExitPoint5:
Subnum = SubnumSave
END SUB
'=========================================================================
SUB PageEject STATIC
'=========================================================================
' Printer Page Eject (Form Feed)
DEFINT A-Z
SubnumSave = Subnum
Subnum = 47
PrinterLineCount = 1
CALL LprintString(CHR$(N12), N1)
Subnum = SubnumSave
END SUB
'=========================================================================
SUB PlayAlarmWarning (WarningSet) STATIC
'=========================================================================
' Play Alarm or Warning Music
DEFINT A-Z
SubnumSave = Subnum
Subnum = 48
IF WarningSet THEN
CALL PlayStuff(Warning$)
ELSE
CALL PlayStuff(Alarm$)
END IF
ErrorSwitch = No
Subnum = SubnumSave
END SUB
'=========================================================================
SUB PopLine STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 49
IF NOT DOS2x THEN
CALL PopLineDelete
CALL ShowIt(N7, N24, N43, " F10," + UpArrow$ + "F10 ")
CALL ShowIt(N6, N0, Nm1, "Pop Down")
END IF
Subnum = SubnumSave
END SUB
'=========================================================================
SUB PopLineDelete STATIC
'=========================================================================
DEFINT A-Z
SubnumSave = Subnum
Subnum = 50
IF NOT DOS2x THEN
CALL ShowErase(N6, N24, N43, N19, Blank0$)
END IF
Subnum = SubnumSave
END SUB
'========================================================================
'======================== END OF CAL4.BAS =============================
'========================================================================